home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / gtlayout / examples / gttest.pas
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  2.9 KB  |  97 lines
  1. program gttest;
  2.  
  3. {
  4.  
  5.     This is just a small test of gtlayout.library.
  6.     It's from gtlayout.doc.
  7.  
  8.     No problems so far.
  9.     16 Jul 2000.
  10.  
  11.     Added MessageBox for report.
  12.     31 Jul 2000.
  13.  
  14.     nils.sjoholm@mailbox.swipnet.se
  15.  
  16. }
  17.  
  18. uses intuition, exec, gadtools, utility, gtlayout, vartags,msgbox;
  19.  
  20.  
  21. var
  22.     handle : pLayoutHandle;
  23.     win : pWindow;
  24.     msg : pIntuiMessage;
  25.     msgQuali : ulong;
  26.     msgclass : ulong;
  27.     msgcode : word;
  28.     msggadget : pGadget;
  29.     done : boolean;
  30.  
  31. procedure CleanUp(why : string; rc : integer);
  32. begin
  33.     LT_DeleteHandle(handle);
  34.     if why <> '' then MessageBox('GTLayout Report',why,'OK');
  35.     halt(rc);
  36. end;
  37.  
  38. begin
  39.     done := false;
  40.     handle := LT_CreateHandleTagList(nil,TAGS(
  41.                     LAHN_AutoActivate, lfalse,
  42.                     TAG_DONE));
  43.     
  44.     if handle = nil then CleanUp('Could''t create a handle',20);
  45.     
  46.     LT_NewA(handle,TAGS(LA_Type,VERTICAL_KIND,       { A vertical group. }
  47.                         LA_LabelText,longstr('Main Group'),
  48.                         TAG_DONE));
  49.  
  50.     LT_NewA(handle,TAGS(LA_Type,BUTTON_KIND,         { A plain button. } 
  51.                         LA_LabelText,longstr('A button'),
  52.                         LA_ID,11,
  53.                         TAG_DONE));
  54.     
  55.     LT_NewA(handle,TAGS(LA_Type,XBAR_KIND,TAG_DONE)); { A separator bar. }
  56.  
  57.     LT_NewA(handle,TAGS(LA_Type,BUTTON_KIND,          { A plain button. }
  58.                         LA_LabelText,longstr('Another button'),
  59.                         LA_ID,22,
  60.                         TAG_DONE));
  61.  
  62.     LT_NewA(handle,TAGS(La_Type,END_KIND,TAG_DONE));  { This ends the current group. } 
  63.  
  64.     win := LT_BuildA(handle,TAGS(LAWN_Title,longstr('Window title'),
  65.                                  LAWN_IDCMP, IDCMP_CLOSEWINDOW,
  66.                                  WA_CloseGadget, ltrue,
  67.                                  TAG_DONE));
  68.  
  69.     if win = nil then CleanUp('Can''t open the window',20);
  70.     
  71.     repeat
  72.         msg := pIntuiMessage(WaitPort(win^.UserPort));
  73.         msg := GT_GetIMsg(win^.UserPort);
  74.         while msg <> nil do begin
  75.             msgclass := msg^.IClass;
  76.             msgcode := msg^.Code;
  77.             msgQuali := msg^.Qualifier;
  78.             msggadget := msg^.IAddress;
  79.             GT_ReplyIMsg(msg);
  80.             LT_HandleInput(handle,msgQuali,msgclass,msgcode,msggadget);
  81.             case msgclass of
  82.                  IDCMP_CLOSEWINDOW : done := true;
  83.                  IDCMP_GADGETUP: begin
  84.                                  case msggadget^.GadgetId of
  85.                                       11 : writeln('First gadget');
  86.                                       22 : writeln('Second gadget');
  87.                                  end;
  88.                                  end;
  89.             end;
  90.             msg := GT_GetIMsg(win^.UserPort);
  91.          end;
  92.      until done;
  93.      CleanUp('all ok',0);
  94. end.
  95.  
  96.  
  97.